home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / t_os / adv2 / adv2.bas next >
BASIC Source File  |  1994-06-01  |  9KB  |  229 lines
  1. 10 '***********************************
  2. 20 '  F-BASIC386 V2.1 L10以降対応
  3. 30 '    アドベンチャー２ システム
  4. 40 '      【めちゃんこべえしっく言語】
  5. 50 '    Copyright(C) 1994 おこめ
  6. 60 '***********************************
  7. 70 CLEAR ,,512,340000,0,450000:DEFINT A-Z:DEFLNG M,I:ON ERROR GOTO *ERR
  8. 80 DIM TXT$(8000),A$(128),B$(255),M(10000),I&(10),T(20000)
  9. 90 DIM S(100000),ST(256),LB$(500),LB(500)
  10. 100 COLOR 7,0,7,4:WIDTH 80,25:CLS
  11. 110 SCREEN 1,0,3,1:SCREEN@1:LOAD@ "GAMEN.TIF":SCREEN 1,1:SCREEN@0
  12. 120 IP=0:IPS=-1:SP=0:LP=500:I=0
  13. 130 TX=172:TY=343:TX2=620:TY2=470:MX=TX:MY=TY:MSG=7
  14. 140 NA$="GAME.AGS"
  15. 150 OPEN "I",#1,NA$
  16. 160 IF EOF(1) THEN CLOSE:GOTO 180
  17. 170 LINE INPUT #1,TXT$(I):I=I+1:GOTO 160
  18. 180 *MAIN A$=TXT$(IP)
  19. 190 IF A$="" THEN GOSUB *MSG:GOTO 400 ELSE IF KTYPE(A$,1)=1 OR ASC(A$)=47 OR ASC(A$)=36 THEN GOSUB *MSG:GOTO 400
  20. 200 GOSUB *GVA
  21. 210 IF INSTR(A$(0),"=") THEN GOSUB *M0
  22. 220 IF INSTR(A$(0),".") THEN GOSUB *GLOAD
  23. 230 IF A$(0)="#" THEN GOSUB *MSGW
  24. 240 IF A$(0)="$" THEN GOSUB *KANE2
  25. 250 IF A$(0)="ITEMSET" THEN GOSUB *ITEMSET
  26. 260 IF A$(0)="GO" THEN GOSUB *GO
  27. 270 IF A$(0)="GOTO" THEN GOSUB *GOT
  28. 280 IF A$(0)="GOSUB" THEN GOSUB *GOS
  29. 290 IF A$(0)="CMD" OR A$(0)="CMDS" THEN GOSUB *CMD
  30. 300 IF A$(0)="ITEM" THEN GOSUB *ITM
  31. 310 IF A$(0)="ON" THEN GOSUB *ON
  32. 320 IF A$(0)="CLS" THEN GOSUB *CLS
  33. 330 IF A$(0)="IF" THEN GOSUB *IF
  34. 340 IF A$(0)="RET" THEN GOSUB *RET
  35. 350 IF A$(0)="RETURN" THEN GOSUB *RETU
  36. 360 IF A$(0)="WAIT" THEN GOSUB *WAIT
  37. 370 IF A$(0)="LOAD" THEN GOSUB *DLOAD
  38. 380 IF A$(0)="SAVE" THEN GOSUB *DSAVE
  39. 390 IF A$(0)="END" THEN *END
  40. 400 IP=IP+1:GOTO 180
  41. 410 *ERR IF ERR=64 AND ERL=2180 THEN KILL "AGS1"+N$:KILL "AGS2"+N$:KILL "ADVG"+N$:RESUME
  42. 420 SYMBOL(0,0),STR$(ERR)+STR$(ERL),2,2,2:END
  43. 430 *GVA I=0:J=0:A$=TXT$(IP):A$(0)=""
  44. 440 IF A$="" THEN A$(I)="":A$=TXT$(IP):RETURN
  45. 450 K=INSTR(A$," "):K2=INSTR(A$,",")
  46. 460 IF K2>0 AND K>K2 THEN K=K2
  47. 470 IF K=1 THEN J=1:A$=MID$(A$,2):GOTO 440
  48. 480 IF J=1 THEN J=0:IF A$(0)<>"" THEN I=I+1:A$(I)=""
  49. 490 IF K=0 THEN A$(I)=A$:A$(I+1)="":A$=TXT$(IP):RETURN
  50. 500 A$(I)=A$(I)+LEFT$(A$,1):A$=MID$(A$,2):GOTO 440
  51. 510 *LAB IF LEFT$(A$(1),1)="M" THEN A$=A$(1):J=1:GOTO *SK
  52. 520 J=0:I=SEARCH(LB$,A$(1),LP)
  53. 530 IF I=-1 THEN
  54. 540   J=SEARCH(TXT$,A$(1)):I=J
  55. 550   IF J=-1 THEN RETURN ELSE LP=LP-1:LB$(LP)=A$(1):LB(LP)=J:I=J
  56. 560 ELSE
  57. 570   I=LB(I)
  58. 580 ENDIF
  59. 590 RETURN
  60. 600 *MSG GOSUB *MSGS
  61. 610 B$=KLEFT$(A$,1):A$=KMID$(A$,2)
  62. 620 IF B$="/" THEN A$(0)=A$:J=1:A$(1)=A$:GOSUB *SK:MSG=I:A$=KMID$(A$(0),KLEN(STR$(I))):GOTO 680
  63. 630 IF B$="$" THEN A$(0)=A$:J=1:A$(1)=A$:GOSUB *KANE:A$=A$(0):GOTO 680
  64. 640 IF B$<>" " AND B$<>"　" THEN BEEP 1:SYMBOL(MX,MY),B$,1,1,7:BEEP 0
  65. 650 MX=MX+LEN(B$)*8
  66. 660 IF MX>TX2-15 AND LEN(A$) THEN MX=TX:MY=MY+17
  67. 670 GOSUB *MSGS
  68. 680 IF PTRIG(1) AND 2 THEN 700
  69. 690 WAIT MSG-1
  70. 700 IF A$<>"" THEN 610
  71. 710 MX=TX:MY=MY+17:RETURN
  72. 720 *MSGS IF MY<TY2-15 THEN RETURN
  73. 730 MY=MY-17:GET@A(170,343)-(629,496),T
  74. 740 FOR I=1 TO 17 STEP 2
  75. 750 PUT@A(170,343)-(629,496),T,,,,,I*116:NEXT:RETURN
  76. 760 *MSGW
  77. 770 IF (PTRIG(1) AND 1)=0 THEN 770
  78. 780 IF PTRIG(1) AND 1 THEN 780
  79. 790 RETURN
  80. 800 *KANE A$=AKCNV$(MID$(STR$(M(KNP)),2+(LEFT$(STR$(KNP),1)="-")))+A$:RETURN
  81. 810 *KANE2 A$=A$(1):J=1:GOSUB *SK:KNP=I:RETURN
  82. 820 *GO GOSUB *LAB:IF I>-1 THEN IPS=IP:IP=I:RETURN ELSE END
  83. 830 *RET IF IPS<>-1 THEN IP=IPS:IPS=-1
  84. 840 RETURN
  85. 850 *GOT GOSUB *LAB:IF I>-1 THEN IP=I
  86. 860 RETURN
  87. 870 *GOS GOSUB *LAB:IF I>-1 THEN SP=SP+1:ST(SP)=IP:IP=I
  88. 880 RETURN
  89. 890 *RETU IP=ST(SP):SP=SP-1:RETURN
  90. 900 *END END
  91. 910 *GLOAD A$=MID$(A$(0),INSTR(A$(0),".")+1)
  92. 920 SCREEN 1,0
  93. 930 IF A$="TIF" OR A$="JPG" THEN LOAD@ A$(0)
  94. 940 IF A$="SND" THEN PLAY OFF:LOAD@ A$(0),S:PCMPLAY S,127
  95. 950 IF A$="EUP" THEN PLAY OFF:LOAD@ A$(0),S:PLAY@ S
  96. 960 IF A$="AGS" THEN GOSUB *NFIL
  97. 970 IF A$="MVE" THEN GOSUB *MVEP
  98. 980 SCREEN 1,1:RETURN
  99. 990 *NFIL NA$=A$(0):IPS=-1:SP=0:GOSUB 1000:GOTO *GOT
  100. 1000 I=0:OPEN "I",#1,NA$
  101. 1010 WHILE EOF(1):LINE INPUT #1,TXT$(I):I=I+1:WEND:CLOSE #1
  102. 1020 LP=500:LB$(LP)="":I=0:RETURN
  103. 1030 *MVEP GET@A(0,0)-(319,239),S:PLAY OFF
  104. 1040 MOVIE OPEN A$(0)
  105. 1050 MOVIE INFO 1,I&
  106. 1060 I=85-I&(7)/2:IF I<0 THEN I=0
  107. 1070 DEF MOVIE 1,(160-I&(6)/2,I)
  108. 1080 MOVIE PLAY
  109. 1090 MOVIE CLOSE
  110. 1100 PUT@A(0,0)-(319,239),S
  111. 1110 RETURN
  112. 1120 *ON IF A$(1)="CMD" OR A$(1)="CMDS" THEN A$(0)=A$(1):A$(1)=A$(2):A$(2)=A$(3):GOSUB *CMDS:I=KC:J=1 ELSE A$=A$(1):J=1:GOSUB *SK:J=0
  113. 1130 A$(0)=A$(2+J):'SYMBOL(0,20),A$(0),2,2,7
  114. 1140 IF LEFT$(A$(0),2)="GO" THEN J=J+1
  115. 1150 J=I+J+1
  116. 1160 IF I>0 AND SEARCH(A$,"")>J THEN
  117. 1170   A$(1)=A$(J)
  118. 1180   IF INSTR(A$(1),".") THEN A$(0)=A$(1):GOTO *GLOAD
  119. 1190   IF A$(0)="GOTO" THEN *GOT
  120. 1200   IF A$(0)="GOSUB" THEN *GOS
  121. 1210   GOTO *GO
  122. 1220 ENDIF
  123. 1230 RETURN
  124. 1240 IF I>0 AND SEARCH(A$,"")>I+2 THEN A$(1)=A$(I+2):GOTO *GO
  125. 1250 RETURN
  126. 1260 *CMD SWAP A$(1),A$(2):GOSUB *CMDS:J=2:GOSUB *SK:M(I)=KC:RETURN
  127. 1270 *CMDS GOSUB *LAB:J=1
  128. 1280 IF CMDLV<>I THEN KC=1:CMDLV=I
  129. 1290 LINE(0,343)-(TX-10,479),PSET,0,BF
  130. 1300 IF TXT$(I+J)="#" OR TXT$(I+J)="" THEN 1330
  131. 1310 SYMBOL(40,328+J*17),TXT$(I+J),1,1,7
  132. 1320 J=J+1:GOTO 1300
  133. 1330 IF PAD(1)+PTRIG(1) THEN 1330
  134. 1340 SYMBOL(22,328+KC*17),"◆",1,1,7
  135. 1350 KKK=0:P=P+T
  136. 1360 WHILE P AND (KKK<1000)
  137. 1370 P=PAD(1)+PTRIG(1):KKK=KKK+1:WEND
  138. 1380 KC2=KC:P=PAD(1):T=PTRIG(1)
  139. 1390 IF P+T=0 THEN 1380
  140. 1400 IF P=1 AND KC>1 THEN KC=KC-1
  141. 1410 IF P=5 AND KC<J-1 THEN KC=KC+1
  142. 1420 IF (T AND 1)=1 THEN 1450
  143. 1430 IF A$(0)="CMDS" AND T=2 THEN KC=0:GOTO 1450
  144. 1440 SYMBOL(22,328+KC2*17),"◆",1,1,0:GOTO 1330
  145. 1450 A$=A$(2):SYMBOL(22,328+KC2*17),"◆",1,1,0:RETURN
  146. 1460 *M0 A$=TXT$(IP):J2=INSTR(A$,"="):J=J2+1:GOSUB *SK
  147. 1470 K2=I:J=2:A$=LEFT$(TXT$(IP),J2-1):GOSUB *SK:M(I)=K2:RETURN
  148. 1480 *SKGVA I=0:Z=1:B$(0)=""
  149. 1490 IF A$="" THEN RETURN
  150. 1500 IF J>LEN(A$) THEN B$(I+1)="":RETURN
  151. 1510 IF KTYPE(A$,J) THEN B$(I+1)="":RETURN
  152. 1520 IF MID$(A$,J,1)=" " THEN J=J+1:GOTO 1520
  153. 1530 IF INSTR("*/+-^=&|M()@",MID$(A$,J,1)) THEN
  154. 1540   IF Z=0 THEN I=I+1
  155. 1550   B$(I)=MID$(A$,J,1):J=J+1:I=I+1:Z=1:B$(I)="":GOTO 1500
  156. 1560 ENDIF
  157. 1570 B$(I)=B$(I)+MID$(A$,J,1):J=J+1:Z=0
  158. 1580 GOTO 1500
  159. 1590 *D2 HZ=2
  160. 1600 ST(SP+1)=I:J=J-1:B$(J-HZ)=STR$(I):I=0
  161. 1610 I=I+1:B$(J-HZ+I)=B$(J+I):IF B$(J+I)<>"" THEN 1610
  162. 1620 I=ST(SP+1):J=J-HZ+1:RETURN
  163. 1630 *SK GOSUB *SKGVA:J=0:K=I:F=0
  164. 1640 GOSUB 1970
  165. 1650 ST(SP+1)=F:SP=SP+2:ST(SP)=I
  166. 1660 IF B$(J)="+" AND F<=8 THEN
  167. 1670   F=8:GOSUB 1960:I=ST(SP)+I:GOSUB *D2
  168. 1680 ELSE IF B$(J)="*" AND F<=9 THEN
  169. 1690   F=9:GOSUB 1960:I=ST(SP)*I:GOSUB *D2
  170. 1700 ELSE IF B$(J)="/" AND F<=9 THEN
  171. 1710   F=9:GOSUB 1960:I=ST(SP)/I:GOSUB *D2
  172. 1720 ELSE IF B$(J)="%" AND F<=9 THEN
  173. 1730   F=9:GOSUB 1960:I=ST(SP) MOD I:GOSUB *D2
  174. 1740 ELSE IF B$(J)="^" AND F<=10 THEN
  175. 1750   F=10:GOSUB 1960:I=ST(SP)^I:GOSUB *D2
  176. 1760 ELSE IF B$(J)="-" AND F<=8 THEN
  177. 1770   F=8:GOSUB 1960:I=ST(SP)-I:GOSUB *D2
  178. 1780 ELSE IF B$(J)=">" AND F<=7 THEN
  179. 1790   F=7:GOSUB 1960:I=(ST(SP)>I):GOSUB *D2
  180. 1800 ELSE IF B$(J)="<" AND F<=7 THEN
  181. 1810   F=7:GOSUB 1960:I=(ST(SP)<I):GOSUB *D2
  182. 1820 ELSE IF B$(J)="=" AND F<=6 THEN
  183. 1830   F=6:GOSUB 1960:I=(ST(SP)=I):GOSUB *D2
  184. 1840 ELSE IF B$(J)="&" AND F<=5 THEN
  185. 1850   F=5:GOSUB 1960:I=ST(SP) AND I:GOSUB *D2
  186. 1860 ELSE IF B$(J)="X" AND F<=4 THEN
  187. 1870   F=4:GOSUB 1960:I=ST(SP) XOR I:GOSUB *D2
  188. 1880 ELSE IF B$(J)="|" AND F<=3 THEN
  189. 1890   F=3:GOSUB 1960:I=ST(SP) OR I:GOSUB *D2
  190. 1900 ELSE IF B$(J)="A" AND F<=2 THEN
  191. 1910   F=2:GOSUB 1960:I=((ST(SP) AND I)<>0):GOSUB *D2
  192. 1920 ELSE IF B$(J)="O" AND F<=1 THEN
  193. 1930   F=1:GOSUB 1960:I=((ST(SP) OR I)<>0):GOSUB *D2
  194. 1940 ENDIF
  195. 1950 F=ST(SP-1):SP=SP-2:RETURN
  196. 1960 J=J+1
  197. 1970 IF B$(J)="M" THEN '変数
  198. 1980   IF B$(J+1)="(" THEN J=J+2:GOSUB 1640:J=J+1:HZ=3:GOSUB 1600:J=J-1 ELSE J=J+1:I=VAL(B$(J))
  199. 1990   I=M(I)
  200. 2000 ELSE IF B$(J)="(" THEN
  201. 2010   J=J+1:GOSUB 1640:J=J+1:GOSUB *D2:J=J-1
  202. 2020 ELSE IF B$(J)="*" OR B$(J)="@" THEN
  203. 2030   WHILE B$(J+1)<>"":J=J+1:B$(J)=B$(J-1)+B$(J):WEND
  204. 2040   A$(1)=B$(J):GOSUB *LAB
  205. 2050 ELSE
  206. 2060   IF B$(J)="-" THEN J=J+1:I=-VAL(B$(J)) ELSE I=VAL(B$(J))
  207. 2070 ENDIF
  208. 2080 J=J+1:RETURN
  209. 2090 *IF A$=A$(1):J=1:GOSUB *SK:IF I=0 THEN RETURN
  210. 2100 IF A$(2)="THEN" THEN A$(2)=A$(3):A$(3)=A$(4):A$(4)=A$(5)
  211. 2110 IF LEFT$(A$(2),2)="GO" THEN A$(1)=A$(3) ELSE A$(1)=A$(2)
  212. 2120 IF A$(2)="GOTO" THEN *GOT
  213. 2130 IF A$(2)="GOSUB" THEN *GOS
  214. 2140 GOTO *GO
  215. 2150 *CLS LINE(TX,343)-(639,479),PSET,0,BF:MY=343:RETURN
  216. 2160 *DSAVE A$=A$(1):J=1:GOSUB *SK:ST(0)=SP
  217. 2170 N$=RIGHT$("0000"+HEX$(I),4)+".DAT"
  218. 2180 SAVE@ "AGS1"+N$,M:SAVE@ "AGS2"+N$,ST
  219. 2190 OPEN "O",#1,"ADVG"+N$:PRINT #1,NA$:PRINT #1,MKL$(IP);MSG
  220. 2200 CLOSE #1:I=1:RETURN
  221. 2210 *DLOAD A$=A$(1):J=1:GOSUB *SK
  222. 2220 N$=RIGHT$("0000"+HEX$(I),4)+".DAT"
  223. 2230 LOAD@ "AGS1"+N$,M:LOAD@ "AGS2"+N$,ST:SP=ST(0)
  224. 2240 OPEN "I",#1,"ADVG"+N$:LINE INPUT #1,NA$:A$=INPUT$(4,1):IP=CVL(A$)
  225. 2250 INPUT #1,MSG:CLOSE #1:GOSUB 1000:I=2:RETURN
  226. 2260 *WAIT A$=A$(1):J=1:GOSUB *SK:WAIT I:RETURN
  227. 2270 *ITEMSET A$=A$(1):GOSUB *SK:ITM=I:RETURN
  228. 2280 *ITM RETURN
  229.